*
* $Id$
*
* $Log: dzswap.F,v $
* Revision 1.1.1.1  2002/06/16 15:18:48  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:22  fca
* AliRoot sources
*
* Revision 1.2  1996/04/24 17:26:18  mclareni
* Extend the include file cleanup to dzebra, rz and tq, and also add
* dependencies in some cases.
*
* Revision 1.1.1.1  1996/03/06 10:47:07  mclareni
* Zebra
*
*
*----------------------------------------------------------
#include "zebra/pilot.h"
      SUBROUTINE DZSWAP (IXSTOR,LSTR1,LSTR2,CHOPT)


#include "zebra/mqsys.inc"
#include "zebra/mzcn.inc"
#include "zebra/qequ.inc"
#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/storparq.inc"
#include "zebra/dzc1.inc"

      CHARACTER    *(*) CHOPT
      SAVE NAMESR
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HZSWA, 4HP    /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HZSWAP  /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      DATA  NAMESR /  'ZSWAP   ' /
#endif
#include "zebra/q_jbit.inc"
#include "zebra/q_jbyt.inc"

#include "zebra/qtrace.inc"

      IF (IXSTOR.NE.NCHEKQ) CALL MZSDIV (IXSTOR,-1)

      L1    = LSTR1
      L2    = LSTR2

      IFLAG = INDEX(CHOPT,'R')


      IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) IFLAG = 0

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.NE.0) WRITE(IQPRNT,
     +'(''0DEVZE ZSWAP,  ENTRY:IXSTOR,LSTR1,LSTR2,IFLAG= '',Z8,3I8)')
     + IXSTOR,L1,L2,IFLAG
#endif

      IF (L1.EQ.0 .OR. L2.EQ.0)                            GO TO 999

      CALL MZCHLS(NCHEKQ,L1)
      IF (IQFOUL.NE.0)                 THEN
          WRITE(IQPRNT,'(''0ZSWAP - BANK1 INVALID'')')
                                                           GO TO 998
      ENDIF

      CALL MZCHLS(NCHEKQ,L2)
      IF (IQFOUL.NE.0)                 THEN
          WRITE(IQPRNT,'(''0ZSWAP - BANK2 INVALID'')')
                                                           GO TO 998
      ENDIF

      LNEXT1 = LQ(KQS+L1)
      IF (LNEXT1.NE.0) CALL MZCHLS(NCHEKQ,LNEXT1)
      IF (IQFOUL.NE.0)                 THEN
          WRITE(IQPRNT,'(''0ZSWAP - Next of LSTR1 invalid'',2I8)')
     +     L1,LNEXT1
                                                           GO TO 998
      ENDIF
      LUP1   = LQLUP(KQS+L1)
      IF (LUP1.NE.0) CALL MZCHLS(NCHEKQ,LUP1)
      IF (IQFOUL.NE.0)                 THEN
          WRITE(IQPRNT,'(''0ZSWAP - Origin of LSTR1 invalid'',2I8)')
     +     L1,LUP1
                                                           GO TO 998
      ENDIF
      LSUP1  = LQLORG(KQS+L1)
      IF (LQ(KQS+LSUP1).NE.L1)         THEN
          WRITE(IQPRNT,'(''0ZSWAP - R link invalid (@r # LSTR1)'',
     +     2I8)') L1,LQ(KQS+LSUP1)
                                                           GO TO 998
      ENDIF

      LNEXT2 = LQ(KQS+L2)
      IF (LNEXT2.NE.0) CALL MZCHLS(NCHEKQ,LNEXT2)
      IF (IQFOUL.NE.0)                 THEN
          WRITE(IQPRNT,'(''0ZSWAP - Next of LSTR2 invalid'',2I8)')
     +     L2,LNEXT2
                                                           GO TO 998
      ENDIF
      LUP2   = LQLUP(KQS+L2)
      IF (LUP2.NE.0) CALL MZCHLS(NCHEKQ,LUP2)
      IF (IQFOUL.NE.0)                 THEN
          WRITE(IQPRNT,'(''0ZSWAP - Origin of LSTR2 invalid'',2I8)')
     +     L2,LUP2
                                                           GO TO 998
      ENDIF
      LSUP2  = LQLORG(KQS+L2)
      IF (LQ(KQS+LSUP2).NE.L2)         THEN
          WRITE(IQPRNT,'(''0ZSWAP - R link invalid (@r # LSTR2)'',
     +     2I8)') L2,LQ(KQS+LSUP2)
                                                           GO TO 998
      ENDIF

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.NE.0) WRITE(IQPRNT,
     +'(''0DEVZE ZSWAP,  Before SWAP ,L1,N,O,P,@P '',5I8,/,
     +  ''       ZSWAP,  Before SWAP ,L2,N,O,P,@P '',5I8)')
     + L1,LQ(KQS+L1),LQLUP(KQS+L1),LQLORG(KQS+L1),
     + LQ(KQS+LQLORG(KQS+L1)),
     + L2,LQ(KQS+L2),LQLUP(KQS+L2),LQLORG(KQS+L2),
     + LQ(KQS+LQLORG(KQS+L2))
#endif

      IF (LNEXT1.EQ.L2) THEN
          LQ(KQS+L1)      = LNEXT2
          LQ(KQS+L2)      = L1
          LQLORG(KQS+L1)  = L2
          LQLORG(KQS+L2)  = LSUP1
          LQ(KQS+LSUP1)   = L2
          IF (LNEXT2.NE.0) LQLORG(KQS+LNEXT2) = L1
      ELSEIF(L1.EQ.LNEXT2) THEN
          LQ(KQS+L1)      = L2
          LQ(KQS+L2)      = LNEXT1
          LQLORG(KQS+L1)  = LSUP2
          LQLORG(KQS+L2)  = L1
          LQ(KQS+LSUP2)   = L1
          IF (LNEXT1.NE.0) LQLORG(KQS+LNEXT1) = L2
      ELSE
          LQ(KQS+L1)      = LNEXT2
          LQ(KQS+L2)      = LNEXT1
          LQLUP(KQS+L1)   = LUP2
          LQLUP(KQS+L2)   = LUP1
          LQLORG(KQS+L1)  = LSUP2
          LQLORG(KQS+L2)  = LSUP1
          LQ(KQS+LSUP1)   = L2
          LQ(KQS+LSUP2)   = L1
          IF (LNEXT1.NE.0) LQLORG(KQS+LNEXT1) = L2
          IF (LNEXT2.NE.0) LQLORG(KQS+LNEXT2) = L1
      ENDIF

      LSTR1  = L2
      LSTR2  = L1

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.NE.0) WRITE(IQPRNT,
     +'(''0DEVZE ZSWAP,  After SWAP ,LSTR1,N,O,P,@P '',5I8,/,
     +  ''       ZSWAP,  After SWAP ,LSTR2,N,O,P,@P '',5I8)')
     + LSTR1,LQ(KQS+LSTR1),LQLUP(KQS+LSTR1),LQLORG(KQS+LSTR1),
     + LQ(KQS+LQLORG(KQS+LSTR1)),
     + LSTR2,LQ(KQS+LSTR2),LQLUP(KQS+LSTR2),LQLORG(KQS+LSTR2),
     + LQ(KQS+LQLORG(KQS+LSTR2))
#endif


      IF (IFLAG.NE.0)      THEN
          LSYSB  = LQSYSS(KQT+MSYLAQ)
          IF(LSYSB.GT.0)                   THEN
              CALL MZCHLS(NCHEKQ,LSYSB)
              IF (IQFOUL.NE.0)                 THEN
                  WRITE(IQPRNT,
     X            '(''0ZSWAP - LINK AREA SYSTEM BANK INVALID'')')
                                                           GO TO 998
              ENDIF


              NWTAB  = IQ(KQS+LSYSB+MLAUSQ)


              LENTRY = LSYSB + KQS + MLAUSQ

              DO 300 IENTRY = 1,(NWTAB-1)/NLAENQ

                  LLAAR1 = IQ(LENTRY+MLAADQ) + KQS
                  LLAARL = IQ(LENTRY+MLALTQ) + KQS
                  NLANS  = IQ(LENTRY+MLANSQ)
                  JTEMP  = JBIT(NLANS,JLATMQ)
                  NTEMP  = NLATMQ*JTEMP
                  NLANS  = JBYT(IQ(LENTRY+MLANSQ),JLANSQ,NLANSQ) - NTEMP
                  IF(JTEMP.EQ.1.AND.LQ(LLAAR1+MLACTQ-1).EQ.0) GO TO 300
                  DO 200 I=LLAAR1+NTEMP+NLANS , LLAARL-1
                      IF (LQ(I).EQ.L1) THEN
                          LQ(I) = L2
                      ELSEIF(LQ(I).EQ.L2) THEN
                          LQ(I) = L1
                      ENDIF
  200             CONTINUE

                  LENTRY = LENTRY + NLAENQ
  300         CONTINUE

          ENDIF



          IDIV1  = 1
          IF (L1.LT.LQEND(KQT+JQDVLL))                     GO TO 410
          IF (L1.GE.LQEND(KQT+NDVMXQ))                     GO TO 998
          IDIV1  = JQDVSY

  410     IF (L1.LT.LQEND(KQT+IDIV1 ))                     GO TO 420
          IDIV1  = IDIV1  + 1
                                                           GO TO 410

  420     IF (L1.LT.LQSTA(KQT+IDIV1 ))                     GO TO 998


          IDIV2  = 1
          IF (L2.LT.LQEND(KQT+JQDVLL))                     GO TO 510
          IF (L2.GE.LQEND(KQT+NDVMXQ))                     GO TO 998
          IDIV2  = JQDVSY

  510     IF (L2.LT.LQEND(KQT+IDIV2 ))                     GO TO 520
          IDIV2  = IDIV2  + 1
                                                           GO TO 510

  520     IF (L2.LT.LQSTA(KQT+IDIV2 ))                     GO TO 998

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.NE.0) WRITE(IQPRNT,
     +'(''0DEVZE ZSWAP,  Divs : L1,IDIV1,L2,IDIV2= '',4I8)')
     + L1,IDIV1,L2,IDIV2
#endif


          DO 1700 JQDIVI = 1,NDVMXQ
              IF (JQDIVI.GT.JQDVLL.AND.JQDIVI.LT.JQDVSY)   GO TO 1700

              LN = LQSTA(KQT+JQDIVI)
 1300         IF (LN.LT.LQEND(KQT+JQDIVI))       THEN
                  CALL MZCHLN(NCHEKQ,LN)
                  IF (IQFOUL.NE.0)                 THEN
                      WRITE(IQPRNT,
     X                '(''0ZSWAP - BANK INVALID AT'',I10)') LN
                                                           GO TO 998
                  ENDIF
                  LN = IQNX
                  IF (JBIT(IQ(KQS+IQLS),IQDROP).EQ.0)           THEN
                      DO 1400 L = IQLS-IQNL+KQS , IQLS-IQNS+KQS-1
                          IF (LQ(L).EQ.L1) THEN
                              LQ(L) = L2
                          ELSEIF(LQ(L).EQ.L2) THEN
                              LQ(L) = L1
                          ENDIF
 1400                 CONTINUE
                  ENDIF
                                                           GO TO 1300
              ENDIF
 1700     CONTINUE

      ENDIF

                                                           GO TO 999

  998 CONTINUE
#include "zebra/qtofatal.inc"

#include "zebra/qtrace99.inc"
      END
